Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/digitr1a/modflash.bas

BASIC Source File | 1999-07-14 | 8KB | 231 lines

Attribute VB_Name = "mdFlashcard"
Option Explicit

Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Public FlashContents As New Collection
Public LoadedByRecord As Boolean
Public MenuRecords As Integer
Public OpenFile As String
Public RecentFileList As New Collection
Public Saved As Boolean
Public SelRecord As Integer
Public CardsPosition As Integer

Global Const BEGINCHARS = "-->>:"
Global Const ERRTAG = "//*ERR//"
Global Const HEADING = "FILEREC"
Global Const HDRECNUM = "ENTRYCOUNT"
Global Const INVCHARERR = "Cannot add entry: invalid characters."
Global Const MAXRECORDNUM = 4
Global Const MESSAGE = "Save changes to this file?"
Global Const MSGDEF = " Definition"
Global Const MSGSHOW = "Show"
Global Const MSGWRD = " Word"
Global Const NOMCHNG = "aeioun!?"
Global Const NOMTAG = "+^"
Global Const RECORDINI = "FSOFT.INI"
Global Const SECTION = "FLASHCARD"
Global Const SEPCHARS = "::"
Global Const SEPCHAR = ";"

Function AreEntries() As Boolean
    AreEntries = FlashContents.Count > 0
End Function

Public Sub CheckForAccents(txtObject As TextBox)
Dim Letter As String, i As Integer
    i = InStr(1, txtObject, NOMTAG)
    If i > 0 Then
        Letter = Right(Left(txtObject, i - 1), 1)
        txtObject.SelStart = i - 2
        txtObject.SelLength = 3
        If InStr(1, NOMCHNG, Letter) = 0 Then
            txtObject.SelStart = i - 1
            txtObject.SelLength = 2
            txtObject.SelText = ""
            Exit Sub
        End If
        Select Case Letter
            Case "a"
                txtObject.SelText = "ß"
            Case "e"
                txtObject.SelText = "Θ"
            Case "i"
                txtObject.SelText = "φ"
            Case "o"
                txtObject.SelText = "≤"
            Case "u"
                txtObject.SelText = "·"
            Case "n"
                txtObject.SelText = "±"
            Case "!"
                txtObject.SelText = "í"
            Case "?"
                txtObject.SelText = "┐"
        End Select
    End If
End Sub

Public Sub CloseFile()
    OpenFile = ""
    Cards.ChangeMode False
    DeleteEntries FlashContents
End Sub

Public Sub DeleteEntries(ByRef DeleteCol As Collection)
Dim i As Integer
    For i = DeleteCol.Count To 1 Step -1
        DeleteCol.Remove i
    Next i
End Sub

Function IsOpenFile() As Boolean
    IsOpenFile = (OpenFile <> "")
End Function

Public Function GetFileContents(FileName As String) As Boolean
Dim NextLine As String
    GetFileContents = True
    On Error GoTo FoundError
    DeleteEntries FlashContents
    Open FileName For Input As #1
    While Not EOF(1)
        Line Input #1, NextLine
        FlashContents.Add NextLine
    Wend
    Close
    Cards.ChangeMode True
    OpenFile = FileName
    Cards.AddMenuRecord OpenFile, True
    Exit Function
FoundError:
    GetFileContents = False
    MsgBox "Error #" & Err.Number & ": " & Err.Description & ".", , Err.Source
    If Err.Number = 53 Or Err.Number = 75 Then
        If LoadedByRecord Then
            RecentFileList.Remove SelRecord
            Cards.ResetFileRecords
        End If
    End If
End Function

Public Sub GetFileRecord()
Dim i As Integer, j As Long, tmpStr As String
Dim NumberExpected As Integer
    DeleteEntries RecentFileList
    tmpStr = Space$(100)
    j = GetPrivateProfileString(SECTION, HDRECNUM, "0", tmpStr, Len(tmpStr), RECORDINI)
    NumberExpected = Val(tmpStr)
    For i = 1 To NumberExpected
        tmpStr = Space$(100)
        j = GetPrivateProfileString(SECTION, HEADING & i, ERRTAG, tmpStr, Len(tmpStr), RECORDINI)
        tmpStr = Trim(tmpStr)
        If tmpStr <> "" And InStr(1, tmpStr, ERRTAG) = 0 Then
            RecentFileList.Add tmpStr
        End If
    Next i
    PrintRecentFileEntries
End Sub

Public Function GetHidden(EntryNumber As Integer) As String
Dim TmpString As String, i As Integer
    If Not AreEntries Then Exit Function
    If Not IsContent(FlashContents(EntryNumber)) Then
        FlashContents.Remove EntryNumber
        Exit Function
    End If
    i = Len(FlashContents(EntryNumber)) - InStr(1, FlashContents(EntryNumber), SEPCHARS)
    GetHidden = Right(FlashContents(EntryNumber), i - 1)
End Function

Public Function GetRevealed(EntryNumber As Integer) As String
Dim TmpString As String, i As Integer
    If Not AreEntries Then Exit Function
    If EntryNumber = 0 Then EntryNumber = 1
    If Not IsContent(FlashContents(EntryNumber)) Then
        FlashContents.Remove EntryNumber
        Exit Function
    End If
    i = InStr(1, FlashContents(EntryNumber), SEPCHARS)
    TmpString = Left(FlashContents(EntryNumber), i - 1)
    GetRevealed = Right(TmpString, Len(TmpString) - Len(BEGINCHARS))
End Function

Public Function IsContent(Contents As String) As Boolean
Dim TmpString As String
    IsContent = True
    TmpString = BEGINCHARS & "*" & SEPCHARS & "*"
    If Not Contents Like TmpString Then IsContent = False
End Function

Sub PrintRecentFileEntries()
Dim i As Integer
    For i = 1 To RecentFileList.Count
        Cards.AddMenuRecord RecentFileList(i)
    Next i
End Sub

Public Function SaveFileContents(FileName As String)
Dim i As Integer
    Saved = True
    Open FileName For Output As #1
    For i = 1 To FlashContents.Count
        Print #1, FlashContents(i)
    Next i
    OpenFile = FileName
    Close #1
End Function

Public Sub SaveFileRecords()
Dim i As Integer
    For i = 1 To MenuRecords
        WritePrivateProfileString SECTION, HEADING & i, CStr(RecentFileList(i)), RECORDINI
    Next i
    WritePrivateProfileString SECTION, HDRECNUM, CStr(MenuRecords), RECORDINI
End Sub

Public Sub SelectAll(Text As TextBox)
    Text.SelStart = 0
    Text.SelLength = Len(Text)
End Sub

Sub SortEntries(Optional InfoMode As Integer)
Dim i As Integer, IsFlaw As Boolean
Dim j As String, k As String, TmpString As String
    Do
        IsFlaw = False
        DoEvents
        For i = FlashContents.Count To 1 Step -1
            If IsValidEntry(FlashContents, i) = True Then
                k = j
                j = GetInfo(i, InfoMode)
                If j > k And i < FlashContents.Count Then
                    IsFlaw = True
                    TmpString = FlashContents(i)
                    FlashContents.Remove i
                    FlashContents.Add (TmpString)
                End If
            End If
        Next i
    Loop Until IsFlaw = False
End Sub

Function GetInfo(Entry As Integer, Mode As Integer) As String
    Mode = Mode Mod 2
    If Mode = 0 Then GetInfo = GetRevealed(Entry)
    If Mode = 1 Then GetInfo = GetHidden(Entry)
End Function

Public Function IsValidEntry(Records As Collection, Entry As Integer)
    IsValidEntry = True
    If Entry > Records.Count Then IsValidEntry = False
    If Entry < 1 Then IsValidEntry = False
    If IsValidEntry = False Then Exit Function
    If Not IsContent(Records(Entry)) Then
        Records.Remove Entry
        IsValidEntry = False
    End If
End Function